unit umfmGUIRunner;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, uSBDUnit_SampleTests1, uSBDUnit_Controller,
  uSBDUnit_View, uSBDUnit_Model, StdCtrls, uSBDUnit_Types, ComCtrls, ImgList,
  ToolWin, ActnMan, ActnCtrls, ActnMenus, PlatformDefaultStyleActnCtrls,
  ActnList, ExtCtrls, TeEngine, Series, TeeProcs, Chart, StdActns;

type
  TmfmGUIRunner = class(TForm, IUnitTestView, IControllingView)
    appevtFirstIdleDetector: TApplicationEvents;
    actmngrGUIRunner: TActionManager;
    sbarGUIRunner: TStatusBar;
    pnlBody: TPanel;
    splLog: TSplitter;
    pnlAboveLog: TPanel;
    pnlTree: TPanel;
    ResultsPanel: TPanel;
    ErrorBoxPanel: TPanel;
    memoLog: TRichEdit;
    imglstStatii16x16: TImageList;
    imglstCheckboxes: TImageList;
    ActionsImages: TImageList;
    tlbrGUIRunner: TToolBar;
    btnRun: TToolButton;
    pbarMain: TProgressBar;
    chrtScore: TChart;
    Series1: TPieSeries;
    treeTestCases: TTreeView;
    lvwProperties: TListView;
    lblPropHeading: TLabel;
    actRun: TAction;
    actSelectAll: TAction;
    actDeselectAll: TAction;
    actToggleSelection: TAction;
    actSelectFailures: TAction;
    actClear: TAction;
    actExit: TFileExit;
    btnAbort: TToolButton;
    sepPlay: TToolButton;
    btnSelectAll: TToolButton;
    btnDeselectAll: TToolButton;
    btnToggleSelection: TToolButton;
    btnSelectFailures: TToolButton;
    sepSelections: TToolButton;
    btnClear: TToolButton;
    btnExit: TToolButton;
    actAbort: TAction;
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure appevtFirstIdleDetectorIdle(Sender: TObject; var Done: Boolean);
    procedure treeTestCasesClick(Sender: TObject);
    procedure treeTestCasesCreateNodeClass(Sender: TCustomTreeView;
      var NodeClass: TTreeNodeClass);
    procedure treeTestCasesKeyPress(Sender: TObject; var Key: Char);
    procedure treeTestCasesChange(Sender: TObject; Node: TTreeNode);
    procedure FormCreate(Sender: TObject);
    procedure actRunExecute(Sender: TObject);
    procedure actRunUpdate(Sender: TObject);
    procedure actSelectAllExecute(Sender: TObject);
    procedure actSelectAllUpdate(Sender: TObject);
    procedure actDeselectAllExecute(Sender: TObject);
    procedure actDeselectAllUpdate(Sender: TObject);
    procedure actToggleSelectionExecute(Sender: TObject);
    procedure actToggleSelectionUpdate(Sender: TObject);
    procedure actSelectFailuresExecute(Sender: TObject);
    procedure actSelectFailuresUpdate(Sender: TObject);
    procedure actClearExecute(Sender: TObject);
    procedure actClearUpdate(Sender: TObject);
    procedure actAbortExecute(Sender: TObject);
    procedure actAbortUpdate(Sender: TObject);

  private
    FSelected: TTreeNode;

    procedure Notify_EngineObserver( const Engine: ITestEngine; isObserver: boolean);
    procedure Notify_EnginePropsChanged( const Engine: ITestEngine; Changes: TEnginePropSet);
    procedure Notify_AddedNode( const Engine: ITestEngine; const NewModelNode: ITestNode);
    procedure Notify_MainViewPropertiesChanged( const Engine: ITestEngine; const ModelNode: ITestNode; Props: TChangeableNodePropertySet);
    procedure Notify_NonFailMessageLogged(
      const Engine: ITestEngine; const ModelNode: ITestNode; MsgIdx: integer);
    procedure ShutDown;
    procedure SetController( const Value: IUnitTestController);
    procedure ClearProperties;
    procedure RevealProperties( const Node: ITestNode);
    function  FindProp( const Name: string; var Idx: integer): boolean;
    procedure RemoveProp( const Name: string);
    procedure SetProp( const Name1, Value1: string);
    procedure SetExecutionResultProp( const Name: string; Value: TExecutionResult);
    procedure SetBooleanProp ( const Name: string; Value: boolean);
    procedure SetNodeKindProp( const Name: string; Value: TNodeKind);
    procedure SetDateTimeProp( const Name: string; Value: TDateTime);
    procedure SetDurationProp( const Name: string; Value: TDateTime);
    procedure SetIntegerProp ( const Name: string; Value: integer);
    procedure SetStatusProp  ( const Name: string; Value: TTestStatus);
    procedure SetDisplay_ExecutionResult( const Node: ITestNode);
    procedure SetDisplay_Enabled( const Node: ITestNode);
    procedure SetDisplay_NodeKind( const Node: ITestNode);
    procedure SetDisplay_StartTime( const Node: ITestNode);
    procedure SetDisplay_EndTime( const Node: ITestNode);
    procedure SetDisplay_Duration( const Node: ITestNode);
    procedure SetDisplay_FailCount( const Node: ITestNode);
    procedure SetDisplay_ExecutionCount( const Node: ITestNode);
    procedure SetDisplay_LoadCount( const Node: ITestNode);
    procedure SetDisplay_Count( const Node: ITestNode);
    procedure SetDisplay_Status( const Node: ITestNode);
    procedure SetDisplay_Failure( const Node: ITestNode);
    procedure AddDisplay_NonFailMsg( const Msg: INonFailMessage);
    procedure Notify_TestFailure( const Engine: ITestEngine; const ModelNode: ITestCaseNode; const ErrMsg: string; WhenError: TDateTime);
    procedure UpdateProgressBar;
    procedure UpdateEnableRelatedFormStats;

  protected
    procedure WndProc( var Message: TMessage); override;

  public
    FModel: ITestEngine;
    FController: IUnitTestController;

    procedure PutFmt( const Fmt: string; const Args: array of const);
    procedure Put( const Line: string);
  end;

var
  mfmGUIRunner: TmfmGUIRunner;

implementation






uses uSBD_ServiceProvider;
{$R *.dfm}

const
  ExecStrs: array[TExecutionResult] of string = ( '', 'Pass', 'Fail');
  MsgKindStrs: array[TNonFailMessageKind] of string = ('Info','Warning');
  BoolStrs: array[boolean] of string =('False','True');
  KindStrs: array[TNodeKind] of string = ( '', 'Test case', 'Test suite', 'group', '');
  StatusStrs: array[TTestStatus] of string = ( 'Ready', 'Setting up',
    'Testing', 'Tearing down', 'User aborted', 'Done', 'Skipped');
  DateTimePropFormat = 'yyyy-mmm-dd hh:nn:ss.zzz';
  LogMsgFmt = '%1s %0s: %2s'; // [0=Kind; 1=Date-stamp; 2=Message]

type
  TTestNodeWrap = class( TTreeNode)
    public
      FModelNode: ITestNode;
      procedure UpdateEnabled;
      procedure UpdateStatus;
    end;

procedure TmfmGUIRunner.appevtFirstIdleDetectorIdle( Sender: TObject;
  var Done: Boolean);
begin
appevtFirstIdleDetector.OnIdle := nil;
TSample1Executive.Instance.StartUp;
pbarMain.Position := 0;
chrtScore.Series[0].Clear;
chrtScore.Series[0].Add( 0, 'passed');
chrtScore.Series[0].Add( 0, 'failed');
chrtScore.Series[0].Add( FModel.Root.LoadCount, 'not yet done');
end;



procedure TmfmGUIRunner.ClearProperties;
begin
lvwProperties.Clear
end;

procedure TmfmGUIRunner.FormCloseQuery( Sender: TObject; var CanClose: Boolean);
begin
CanClose := (not assigned( FController)) or
            (self <> Application.MainForm) or
            FController.Can_ShutDown
end;

procedure TmfmGUIRunner.FormCreate(Sender: TObject);
begin
ClearProperties;
memoLog.Clear
end;

procedure TmfmGUIRunner.FormDestroy( Sender: TObject);
begin
if assigned( FController) and (self = Application.MainForm) then
  FController.ShutDown
end;

procedure TmfmGUIRunner.Notify_EngineObserver(
  const Engine: ITestEngine; isObserver: boolean);
begin
if isObserver then
    FModel := Engine
  else
    FModel := nil
end;

procedure TmfmGUIRunner.Notify_AddedNode(
  const Engine: ITestEngine; const NewModelNode: ITestNode);
var
  ParentTreeNode: TTestNodeWrap;
  AddendTreeNode: TTestNodeWrap;
begin
if assigned( NewModelNode.Parent) and assigned( NewModelNode.Parent.Parent) then
    ParentTreeNode := NewModelNode.Parent.ViewToken as TTestNodeWrap
  else
    ParentTreeNode := nil;
if assigned( NewModelNode.Parent) then
  AddendTreeNode := treeTestCases.Items.AddChild( ParentTreeNode, NewModelNode.Name) as TTestNodeWrap;
NewModelNode.ViewToken    := AddendTreeNode;
if assigned( AddendTreeNode) then
  begin
  AddendTreeNode.FModelNode := NewModelNode;
  AddendTreeNode.UpdateEnabled;
  AddendTreeNode.UpdateStatus;
  treeTestCases.Invalidate
  end;
end;


procedure TmfmGUIRunner.UpdateProgressBar;
begin
pbarMain.Position := FModel.Root.ExecuteCount
end;


procedure TmfmGUIRunner.Notify_EnginePropsChanged( const Engine: ITestEngine; Changes: TEnginePropSet);
var
  j: integer;
begin
if propStarted in Changes then
  begin
  for j := 0 to treeTestCases.Items.Count - 1 do
    treeTestCases.Items[j].Expand( True)
  end;

if propOptions in Changes then
  begin

  end;

if propIsRunning in Changes then
  begin
  if Engine.isRunning then
      begin
      sbarGUIRunner.Panels[0].Text := 'Running';
      Put( 'Test run commenced.')
      end
    else
      begin
      sbarGUIRunner.Panels[0].Text := 'Idle';
      UpdateProgressBar;
      if Engine.Root.FailCount = 0 then
        Put( 'Test run completed flawlessly.')
      else if Engine.Root.FailCount = 1 then
        Put( 'Test run completed with 1 test cases failure.')
      else
        PutFmt( 'Test run completed with %d test cases failures.', [Engine.Root.FailCount])
      end;
  sbarGUIRunner.Invalidate
  end;

if propShutdown in Changes then
  begin
  end
end;


procedure TmfmGUIRunner.Notify_MainViewPropertiesChanged(
  const Engine: ITestEngine; const ModelNode: ITestNode; Props: TChangeableNodePropertySet);
var
  Node: TTestNodeWrap;
  TestCaseNode: ITestCaseNode;
  Msg: INonFailMessage;
begin
if assigned( ModelNode) and assigned( ModelNode.ViewToken) then
    Node := ModelNode.ViewToken as TTestNodeWrap
  else
    Node := nil;

if (propEnabled in Props) and assigned( Node) then
  Node.UpdateEnabled;

if (propExecResult in Props) and assigned( Node) then
  begin
  if FSelected = Node then
    begin
    SetDisplay_ExecutionResult( ModelNode);
    SetDisplay_Failure( ModelNode)
    end;
  if ModelNode.Status = sDone then
    Node.UpdateStatus;
  end;

if (propStatus in Props) and assigned( Node) then
  Node.UpdateStatus;

if (propTimes in Props) and assigned( Node) then
  begin

  if FSelected = Node then
    begin
    SetDisplay_StartTime( ModelNode);
    SetDisplay_EndTime  ( ModelNode);
    SetDisplay_Duration ( ModelNode)
    end;
  end;

if propFailCount in Props then
  begin
  if assigned( Node) then
      begin
      if FSelected = Node then
        SetDisplay_FailCount( ModelNode)
      end
    else
      begin
      if ModelNode = FModel.Root then
        begin
        chrtScore.Series[0].YValue[0] := FModel.Root.ExecuteCount - FModel.Root.FailCount;
        chrtScore.Series[0].YValue[1] := FModel.Root.FailCount;
        chrtScore.Invalidate;
        sbarGUIRunner.Panels[3].Text := Format( 'Failed = %d', [FModel.Root.FailCount]);
        sbarGUIRunner.Invalidate
        end
      end
  end;

if propExecCount in Props then
  begin
  if assigned( Node) then
      begin
      if FSelected = Node then
        SetDisplay_ExecutionCount( ModelNode)
      end
    else
      begin
      if ModelNode = FModel.Root then
        begin
        chrtScore.Series[0].YValue[0] := FModel.Root.ExecuteCount - FModel.Root.FailCount;
        chrtScore.Series[0].YValue[2] := FModel.Root.LoadCount    - FModel.Root.ExecuteCount;
        chrtScore.Invalidate;
        sbarGUIRunner.Panels[2].Text := Format( 'Done = %d', [FModel.Root.ExecuteCount]);
        sbarGUIRunner.Invalidate;
        UpdateProgressBar
        end
      end
  end;

if propLoadCount in Props then
  begin
  if assigned( Node) then
      begin
      if FSelected = Node then
        SetDisplay_LoadCount( ModelNode)
      end
    else
      begin
      if ModelNode = FModel.Root then
        begin
        chrtScore.Series[0].YValue[2] := FModel.Root.LoadCount;
        chrtScore.Invalidate;
        sbarGUIRunner.Panels[1].Text := Format( 'Load = %d', [FModel.Root.LoadCount]);
        sbarGUIRunner.Invalidate
        end
      end
  end
end;


procedure TmfmGUIRunner.Notify_NonFailMessageLogged(
  const Engine: ITestEngine; const ModelNode: ITestNode; MsgIdx: integer);
var
  TestCaseNode: ITestCaseNode;
  Msg: INonFailMessage;
begin
if Supports( ModelNode, ITestCaseNode, TestCaseNode) then
  begin
  Msg := TestCaseNode.NonFailMessages[MsgIdx];
  with Msg do
    PutFmt( LogMsgFmt, [MsgKindStrs[Kind], FormatDateTime( DateTimePropFormat, Stamp), Msg]);
  if FSelected = ModelNode.ViewToken then
    AddDisplay_NonFailMsg( Msg);
  if (Msg.Kind = mkWarning) and (ModelNode.Status = sDone) and
     (ModelNode.ExecutionResult = erPass) and assigned( ModelNode.ViewToken) then
    (ModelNode.ViewToken as TTestNodeWrap).UpdateStatus
  end
end;

procedure TmfmGUIRunner.Notify_TestFailure(const Engine: ITestEngine;
  const ModelNode: ITestCaseNode; const ErrMsg: string; WhenError: TDateTime);
begin
PutFmt( LogMsgFmt, ['Failure', FormatDateTime( DateTimePropFormat, ModelNode.FailStamp), ModelNode.FailMessage]);
if FSelected = ModelNode.ViewToken then
  begin
  SetDisplay_ExecutionResult( ModelNode);
  SetDisplay_Failure( ModelNode)
  end
end;

procedure TmfmGUIRunner.Put( const Line: string);
begin
memoLog.Lines.Add( Line)
end;

procedure TmfmGUIRunner.PutFmt( const Fmt: string; const Args: array of const);
begin
Put( Format( Fmt, Args))
end;


function TmfmGUIRunner.FindProp( const Name: string; var Idx: integer): boolean;
var
  ListItem: TListItem;
begin
ListItem := lvwProperties.FindCaption( 0, Name, False, False, False);
result := assigned( ListItem);
if result then
    Idx := ListItem.Index
  else
    Idx := -1
end;

procedure TmfmGUIRunner.RemoveProp( const Name: string);
var
  Idx: integer;
begin
if FindProp( Name, Idx) then
  lvwProperties.Items.Delete( Idx);
lvwProperties.Invalidate
end;


procedure TmfmGUIRunner.SetProp( const Name1, Value1: string);
var
  Idx: integer;
begin
with lvwProperties do
  if FindProp( Name1, Idx) then
     Items[Idx].SubItems[0] := Value1
   else
     with Items.Add do
       begin
       Caption := Name1;
       SubItems.Add( Value1)
       end;
lvwProperties.Invalidate
end;

procedure TmfmGUIRunner.SetExecutionResultProp( const Name: string; Value: TExecutionResult);
begin
SetProp( Name, ExecStrs[ Value])
end;

procedure TmfmGUIRunner.SetBooleanProp ( const Name: string; Value: boolean);
begin
SetProp( Name, BoolStrs[ Value])
end;

procedure TmfmGUIRunner.SetNodeKindProp( const Name: string; Value: TNodeKind);
begin
SetProp( Name, KindStrs[ Value])
end;

procedure TmfmGUIRunner.SetDateTimeProp( const Name: string; Value: TDateTime);
begin
  if Value <> 0.0 then
      SetProp( Name, FormatDateTime( DateTimePropFormat, Value))
    else
      SetProp( Name, '')
end;

procedure TmfmGUIRunner.SetDurationProp( const Name: string; Value: TDateTime);
  var
    V: double;
    Units: string;
begin
V := Value * SecsPerDay;
if V <= 5 then
    begin
    V := 1000 * V;
    Units := 'ms'
    end
  else
    Units := 's';
SetProp( Name, Format( '%d %s', [ Round( V), Units ]))
end;

procedure TmfmGUIRunner.SetIntegerProp ( const Name: string; Value: integer);
begin
SetProp( Name, Format( '%d', [Value]))
end;


procedure TmfmGUIRunner.SetStatusProp  ( const Name: string; Value: TTestStatus);
begin
SetProp( Name, StatusStrs[ Value])
end;


procedure TmfmGUIRunner.SetDisplay_ExecutionResult( const Node: ITestNode);
begin
SetExecutionResultProp( 'Result', Node.ExecutionResult);
end;

procedure TmfmGUIRunner.SetDisplay_Enabled( const Node: ITestNode);
begin
SetBooleanProp( 'Enabled', Node.Enabled)
end;

procedure TmfmGUIRunner.SetDisplay_NodeKind( const Node: ITestNode);
begin
SetNodeKindProp( 'Node kind', Node.Kind)
end;

procedure TmfmGUIRunner.SetDisplay_StartTime( const Node: ITestNode);
begin
SetDateTimeProp( 'Start', Node.ExecutionStartTime)
end;

procedure TmfmGUIRunner.SetDisplay_EndTime( const Node: ITestNode);
begin
SetDateTimeProp( 'End', Node.ExecutionEndTime)
end;

procedure TmfmGUIRunner.SetDisplay_Duration( const Node: ITestNode);
begin
SetDurationProp( 'Duration', Node.ExecutionDuration)
end;

procedure TmfmGUIRunner.SetDisplay_FailCount( const Node: ITestNode);
begin
SetIntegerProp( 'Fail count', Node.FailCount)
end;

procedure TmfmGUIRunner.SetDisplay_ExecutionCount( const Node: ITestNode);
begin
SetIntegerProp( 'Execution count', Node.ExecuteCount)
end;

procedure TmfmGUIRunner.SetDisplay_LoadCount( const Node: ITestNode);
begin
SetIntegerProp( 'Load count', Node.LoadCount)
end;

procedure TmfmGUIRunner.SetDisplay_Count( const Node: ITestNode);
begin
SetIntegerProp( 'Child count', Node.Count)
end;

procedure TmfmGUIRunner.SetDisplay_Status( const Node: ITestNode);
begin
SetStatusProp( 'Run status', Node.Status)
end;

procedure TmfmGUIRunner.SetDisplay_Failure( const Node: ITestNode);
var
  TestCaseNode: ITestCaseNode;
begin
if Supports( Node, ITestCaseNode, TestCaseNode) then
  begin
  if TestCaseNode.FailMessage <> '' then
      begin
      SetProp( 'Failure', TestCaseNode.FailMessage);
      SetDateTimeProp( 'Failed at', TestCaseNode.FailStamp);
      end
    else
      begin
      RemoveProp( 'Failure');
      RemoveProp( 'Failed at')
      end
  end
end;

procedure TmfmGUIRunner.actRunExecute( Sender: TObject);
begin
pbarMain.Position := 0;
pbarMain.Max := FModel.Root.LoadCount;
FController.Run
end;

procedure TmfmGUIRunner.actRunUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FModel) and FModel.Can_Run
end;

procedure TmfmGUIRunner.AddDisplay_NonFailMsg( const Msg: INonFailMessage);
begin
with lvwProperties.Items.Add do
  begin
  Caption := MsgKindStrs[ Msg.Kind];
  SubItems.Add( Msg.Msg)
  end;
lvwProperties.Invalidate
end;



procedure TmfmGUIRunner.RevealProperties( const Node: ITestNode);
var
  TestCaseNode: ITestCaseNode;
  Msg: INonFailMessage;
begin
lvwProperties.Clear;
SetProp( 'Name', Node.Name);
SetDisplay_ExecutionResult( Node);
SetDisplay_Enabled        ( Node);
SetDisplay_NodeKind       ( Node);
SetDisplay_StartTime      ( Node);
SetDisplay_EndTime        ( Node);
SetDisplay_Duration       ( Node);
SetDisplay_FailCount      ( Node);
SetDisplay_ExecutionCount ( Node);
SetDisplay_LoadCount      ( Node);
SetDisplay_Count          ( Node);
SetDisplay_Status         ( Node);
SetDisplay_Failure        ( Node);
if Supports( Node, ITestCaseNode, TestCaseNode) then
  for Msg in TestCaseNode.NonFailMessages do
    AddDisplay_NonFailMsg( Msg)
end;



procedure TmfmGUIRunner.SetController( const Value: IUnitTestController);
begin
FController := Value
end;

procedure TmfmGUIRunner.ShutDown;
begin
treeTestCases.Items.Clear;
FModel := nil;
FController := nil
end;

procedure TmfmGUIRunner.treeTestCasesChange( Sender: TObject; Node: TTreeNode);
begin
if FSelected <> Node then
  begin
  FSelected := Node;
  if assigned( FSelected) then
      RevealProperties( (FSelected as TTestNodeWrap).FModelNode)
    else
      ClearProperties
  end;
end;

procedure TmfmGUIRunner.treeTestCasesClick( Sender: TObject);
var
  Point: TPoint;
  Node: TTestNodeWrap;
begin
if not GetCursorPos( Point) then exit;
Point := treeTestCases.ScreenToClient( Point);
with Point do
  begin
  Node := treeTestCases.GetNodeAt( X, Y) as TTestNodeWrap;
  if assigned( Node) and
     (htOnIcon in treeTestCases.GetHitTestInfoAt( X, Y)) then
    Node.FModelNode.Enabled := not Node.FModelNode.Enabled
  end
end;

procedure TmfmGUIRunner.treeTestCasesCreateNodeClass(
  Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
begin
NodeClass := TTestNodeWrap
end;

procedure TmfmGUIRunner.treeTestCasesKeyPress(Sender: TObject; var Key: Char);
var
  Node: ITestNode;
begin
if (Key = ' ') and (treeTestCases.Selected <> nil) then
  begin
  Key := #0;
  Node := (treeTestCases.Selected as TTestNodeWrap).FModelNode;
  Node.Enabled := not Node.Enabled
  end;
end;

procedure TmfmGUIRunner.WndProc( var Message: TMessage);
var
  WindowedController: IMainThreadedWindowedClient;
begin
if (not Supports( FController, IMainThreadedWindowedClient, WindowedController)) or
   (not WindowedController.WndProc( Message)) then
  inherited WndProc( Message)
end;


procedure TmfmGUIRunner.UpdateEnableRelatedFormStats;
begin
end;



{ TTestNodeWrap }

procedure TTestNodeWrap.UpdateEnabled;
var
  NewImageIndex: integer;
  Form: TmfmGUIRunner;
begin
if not assigned( FModelNode) then exit;
case FModelNode.TernaryChecked of
  TernaryFalse: NewImageIndex := 0;
  TernaryTrue : NewImageIndex := 2;
  TernaryOmega: NewImageIndex := 1;
  end;
if ImageIndex <> NewImageIndex then
  begin
  ImageIndex    := NewImageIndex;
  SelectedIndex := NewImageIndex;
  TreeView.Invalidate
  end;
Form := TreeView.Owner as TmfmGUIRunner;
if Form.FSelected = self then
  Form.SetDisplay_Enabled( FModelNode);
Form.UpdateEnableRelatedFormStats
end;


procedure TTestNodeWrap.UpdateStatus;
var
  NewStateIndex: integer;
  Form: TmfmGUIRunner;
  TestCaseNode: ITestCaseNode;
  Msg: INonFailMessage;
begin
if not assigned( FModelNode) then exit;
case FModelNode.Status of
  sReady      : NewStateIndex := 8;   // TurquoiseRoundedRect16x16.bmp
  sSettingUp  : NewStateIndex := 2;   // BlueGreenUpArrowRect16x16.bmp
  sTesting    : NewStateIndex := 3;   // Gauge1_16x16.bmp
  sTearingDown: NewStateIndex := 1;   // BlueDownArrowRect16x16.bmp
  sUserAborted: NewStateIndex := 9;   // YellowBox16x16.bmp
  sDone       :
    case FModelNode.ExecutionResult of
      erNull  : NewStateIndex := 7;   // SmallGreyBox16x16.bmp
      erPass  :
        begin
        NewStateIndex := 4;   // LimeCheck16x16.bmp
        if Supports( FModelNode, ITestCaseNode, TestCaseNode) then
          for Msg in TestCaseNode.NonFailMessages do
            if Msg.Kind = mkWarning then
              begin
              NewStateIndex := 5;   // LimeCheckWithExclaim16x16.bmp
              break
              end
        end;
      erFail  : NewStateIndex := 6;   // RedCross16x16.bmp
      end;
  sSkipped    : NewStateIndex := 10;  // YellowRightArrow16x16.bmp
  end;
if StateIndex <> NewStateIndex then
  begin
  StateIndex := NewStateIndex;
  TreeView.Invalidate
  end;
Form := TreeView.Owner as TmfmGUIRunner;
if Form.FSelected = self then
  Form.SetDisplay_Status( FModelNode)
end;


procedure TmfmGUIRunner.actAbortExecute( Sender: TObject);
begin
FController.Abort
end;

procedure TmfmGUIRunner.actAbortUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_Abort
end;

procedure TmfmGUIRunner.actClearExecute( Sender: TObject);
begin
FController.Clear
end;

procedure TmfmGUIRunner.actClearUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_Clear
end;

procedure TmfmGUIRunner.actDeselectAllExecute( Sender: TObject);
begin
FController.DeselectAll
end;

procedure TmfmGUIRunner.actDeselectAllUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_DeselectAll
end;

procedure TmfmGUIRunner.actSelectAllExecute( Sender: TObject);
begin
FController.SelectAll
end;

procedure TmfmGUIRunner.actSelectAllUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_SelectAll
end;

procedure TmfmGUIRunner.actSelectFailuresExecute( Sender: TObject);
begin
FController.SelectFailures
end;

procedure TmfmGUIRunner.actSelectFailuresUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_SelectFailures
end;

procedure TmfmGUIRunner.actToggleSelectionExecute( Sender: TObject);
begin
FController.ToggleSelection
end;

procedure TmfmGUIRunner.actToggleSelectionUpdate( Sender: TObject);
begin
(Sender as TAction).Enabled := assigned( FController) and FController.Can_ToggleSelection
end;


end.
